home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1991 September & October / rerun-1991-09-10.d64 / moon phases (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1991-01-01  |  12.2 KB  |  384 lines
  1. 4 printchr$(142);chr$(8)"[147]":p$="menu runner":poke53264,0
  2. 8 printtab(9)"[154]please wait while data":printtab(12)"is being loaded"
  3. 12 poke53281,0:v=53248:pokev,190:pokev+1,106:pokev+2,190:pokev+3,148
  4. 16 pokev+4,234:pokev+5,106:pokev+6,234:pokev+7,148:pokev+29,15:pokev+23,15
  5. 20 poke53280,12:nm=332.195833:dn=int(nm):ky=1989
  6. 24 sd=54272:for i=sd to sd+23:poke i,0:next:poke sd+24,15:poke 788,52
  7. 28 forp1=15360 to 15422:readq1:pokep1,q1:next
  8. 32 forp2=15424 to 15486:readq2:pokep2,q2:next
  9. 36 forp3=15488 to 15550:readq3:pokep3,q3:next
  10. 40 forp4=15552 to 15614:readq4:pokep4,q4:next
  11. 44 forp5=15616 to 15678:readq5:pokep5,q5:next
  12. 48 forp6=15680 to 15742:readq6:pokep6,q6:next
  13. 52 forp7=15744 to 15806:readq7:pokep7,q7:next
  14. 56 forp8=15808 to 15870:readq8:pokep8,q8:next
  15. 60 forp9=15872 to 15934:readq9:pokep9,q9:next
  16. 64 forp10=15936 to 15998:readq10:pokep10,q10:next
  17. 68 forp11=16000 to 16062:readq11:pokep11,q11:next
  18. 72 forp12=16064 to 16126:readq12:pokep12,q12:next
  19. 76 forp13=16128 to 16190:readq13:pokep13,q13:next
  20. 80 forp14=16192 to 16254:readq14:pokep14,q14:next
  21. 84 forp15=16256 to 16318:readq15:pokep15,q15:next
  22. 88 forp16=16320 to 16382:readq16:pokep16,q16:next:goto176
  23. 92 poke v+21,0:print"[147]"
  24. 96 printtab(14)"[159]loading me[158]n[159]u":print"[144]load"chr$(34)p$chr$(34)",8"
  25. 100 poke198,4:poke631,13:poke632,82:poke633,213:poke634,13:end
  26. 104 print"[147]":pokev+21,0:poke53281,14:poke53280,14:sys64738
  27. 108 for w=1 to 1000:next w
  28. 112 poke 198,0
  29. 116 for c=1 to 10
  30. 120 get c$:if c$="[136]"then92
  31. 124 if c$="[140]"then104
  32. 128 if c$<>"[136]" and c$<>"[140]" and c$<>""then176
  33. 132 next
  34. 136 print" [146]press any key[145]"
  35. 140 for d=1 to 30
  36. 144 get d$:if d$="[136]"then92
  37. 148 if d$="[140]"then104
  38. 152 if d$<>"[136]" and d$<>"[140]" and d$<>""then176
  39. 156 next
  40. 160 print" [152]press[146] any[146] key[145]"
  41. 164 goto116
  42. 168 print"[145]                   [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";:return
  43. 172 printtab(8+len(s$))"[145] [157]":s$="":return
  44. 176 gosub936:poke198,0
  45. 180 pokev+21,0:md=0:l=0:y$="0":m$="0":d$="0":ah$="0":print"[147]"
  46. 184 print" year ? [156]";:y$=""
  47. 185 if xx>10 then xx=0
  48. 186 if xx>5 then print" [157]";:goto 190
  49. 188 print"[164][157]";
  50. 190 get a$
  51. 192 if a$="[136]"then92
  52. 196 if a$="[140]"then104
  53. 200 if a$=chr$(19) then176
  54. 204 if a$=chr$(20) then print:gosub936:gosub168:goto184
  55. 208 if a$=chr$(13) then print:s$=y$:gosub172:goto224
  56. 212 if a$<"0" or a$>"9" then222
  57. 216 if len(y$)>3 then222
  58. 220 print a$;:y$=y$+a$
  59. 222 xx=xx+1:goto 185
  60. 224 yy=val(y$)
  61. 228 if yy>2500 or yy<1582 then gosub168:goto184
  62. 232 gosub936
  63. 236 print" month? [156]";:m$=""
  64. 237 if xx>10 then xx=0
  65. 238 if xx>5 then print" [157]";:goto 242
  66. 240 print"[164][157]";
  67. 242 get a$
  68. 244 if a$=chr$(19) then176
  69. 248 if a$=chr$(20) then print:gosub936:gosub168:goto236
  70. 252 if a$=chr$(13) then print:s$=m$:gosub172:goto268
  71. 256 if a$<"0" or a$>"9" then266
  72. 260 if len(m$)>1 then266
  73. 264 print a$;:m$=m$+a$
  74. 266 xx=xx+1:goto 237
  75. 268 mm=val(m$)
  76. 272 ifmm<1ormm>12 then gosub168:goto236
  77. 276 if yy=1582 and mm<10 then gosub168:goto236
  78. 280 gosub936
  79. 284 print" day  ?[156] ";:d$=""
  80. 285 if xx>10 then xx=0
  81. 286 if xx>5 then print" [157]";:goto 290
  82. 288 print"[164][157]";
  83. 290 get a$
  84. 292 if a$=chr$(19) then176
  85. 296 if a$=chr$(20) then print:gosub936:gosub168:goto284
  86. 300 if a$=chr$(13) then print:s$=d$:gosub172:dd=val(d$):goto324
  87. 304 if a$<"0" or a$>"9" then314
  88. 308 if len(d$)>1 then314
  89. 312 print a$;:d$=d$+a$
  90. 314 xx=xx+1:goto 285
  91. 316 if mm=2 and dd>29 then gosub168:goto284
  92. 320 goto332
  93. 324 if((yy/4=int(yy/4))and(yy/100<>int(yy/100)))or(yy/400=int(yy/400))then316
  94. 328 if mm=2 and dd>28 then gosub168:goto284
  95. 332 if(mm=4 or mm=6 or mm=9 or mm=11)and dd>30 then gosub168:goto284
  96. 336 if dd<1 or dd>31 then gosub168:goto284
  97. 340 dd=dd-1
  98. 344 if yy=1582andmm=10anddd<14thengosub168:goto284
  99. 348 gosub936
  100. 352 print" hour ?[156] ";:ah$="":ap$=""
  101. 353 if xx>8 then xx=0
  102. 354 if xx>4 then print" [157]";:goto 358
  103. 356 print"[164][157]";
  104. 358 get a$
  105. 360 a=val(a$)
  106. 364 if a$=chr$(19) then176
  107. 368 if a$=chr$(20) then print:gosub936:gosub168:goto352
  108. 372 if a$=chr$(13) then print:s$=ah$:gosub172:goto400
  109. 376 if a$="a" or a$="p" or a$="m" then384
  110. 380 if a$<"0" or a$>"9" then398
  111. 384 if len(ah$)>3 then398
  112. 388 print a$;
  113. 392 if a$<>right$(str$(a),len(a$)) then ap$=ap$+a$
  114. 396 ah$=ah$+a$
  115. 398 xx=xx+1:goto 353
  116. 400 ah=val(ah$)
  117. 404 if ah<1 or ah>12 thengosub168:goto352
  118. 408 aq$=right$(ah$,2)
  119. 412 if aq$<>ap$ then gosub168:goto352
  120. 416 if aq$<>"am" and aq$<>"pm" then gosub168:goto352
  121. 420 if ap$="am" and ah=12 then ah=0
  122. 424 if ap$="pm" and ah<12 then ah=ah+12
  123. 428 ah=ah/24
  124. 432 gosub936
  125. 436 print"[145][145][145][145]"tab(20)" moon phase: [146]":printtab(22)"working...[158]"
  126. 440 y=yy-ky:n=sgn(y):yd=y*365
  127. 448 for mn=1 to mm-1
  128. 452 dc=31
  129. 456 if mm=1 then dc=0
  130. 460 if mn=2 then dc=28
  131. 464 if mn=4 or mn=6 or mn=9 or mn=11 then dc=30
  132. 468 md=md+dc
  133. 472 next mn
  134. 476 gosub700
  135. 480 if n=0 then n=1
  136. 484 yt=abs(n*(yd+md+dd+ah-nm)+l)
  137. 488 ya=abs(n*(yd+md+dd+ah-dn)+l)
  138. 492 if yd+md+dd+ah<=nm then512
  139. 500 lm=(yt/29.53058):pf=lm-int(lm):lp=pf*29.53058
  140. 504 wn=ya/7:df=wn-int(wn):dw=(df*7)+1.01
  141. 508 goto520
  142. 512 lm=(yt/29.53058):pf=lm-int(lm):lp=29.53058-(pf*29.53058)
  143. 516 wn=ya/7:df=wn-int(wn):dw=7-(df*7)+1.01
  144. 520 b=abs(lp)*1000+.5:mp=sgn(lp)*int(b)/1000
  145. 524 if yy=ky and md+dd=dn then dw=1.01
  146. 528 if dw>8 then dw=1.01
  147. 532 if dw>5 and dw<6 then dw$=" sunday"
  148. 536 if dw>6 and dw<7 then dw$=" monday"
  149. 540 if dw>7 and dw<8 then dw$=" tuesday"
  150. 544 if dw>1 and dw<2 then dw$="wednesday"
  151. 548 if dw>2 and dw<3 then dw$="thursday"
  152. 552 if dw>3 and dw<4 then dw$=" friday"
  153. 556 if dw>4 and dw<5 then dw$="saturday"
  154. 560 gosub944
  155. 564 if mp>=1.845 and mp<=5.535 then n3=248:n4=249:n5=12:n8=6:n9=6:goto572
  156. 568 goto576
  157. 572 print""tab(20)"first crescent":gosub720
  158. 576 if mp>=5.536 and mp<=9.225 then n3=241:n4=243:n5=12:n8=14:n9=14:goto584
  159. 580 goto588
  160. 584 print""tab(20)"first quarter":gosub720
  161. 588 if mp>=9.226 and mp<=12.915 then goto596
  162. 592 goto604
  163. 596 n1=253:n2=252:n3=241:n4=243:n5=15:n6=3:n7=3:n8=3:n9=3
  164. 600 print""tab(20)"waxing gibbous":gosub720
  165. 604 if mp>=12.916 and mp<=16.605 then goto612
  166. 608 goto620
  167. 612 n1=240:n2=242:n3=241:n4=243:n5=15:n6=1:n7=1:n8=1:n9=1
  168. 616 print""tab(22)"full moon ":gosub720
  169. 620 if mp>=16.606 and mp<=20.295 then goto628
  170. 624 goto636
  171. 628 n1=240:n2=242:n3=254:n4=255:n5=15:n6=3:n7=3:n8=3:n9=3
  172. 632 print""tab(20)"waning gibbous":gosub720
  173. 636 if mp>=20.296 and mp<=23.985 then n1=240:n2=242:n5=3:n6=14:n7=14:goto644
  174. 640 goto648
  175. 644 print""tab(20)"last quarter":gosub720
  176. 648 if mp>=23.986 and mp<=27.675 then n1=250:n2=251:n5=3:n6=6:n7=6:goto656
  177. 652 goto660
  178. 656 print""tab(20)"last crescent":gosub720
  179. 660 if(mp>=27.676 and mp<=29.53)or(mp>=0and mp<=1.844)then goto668
  180. 664 goto676
  181. 668 n1=244:n2=246:n3=245:n4=247:n5=15:n6=1:n7=1:n8=1:n9=1
  182. 672 print""tab(22)"new moon  ":gosub720
  183. 676 goto108
  184. 680 if n=1 then692
  185. 684 if mm>2 and mm<13 then l=l-1
  186. 688 goto696
  187. 692 if mm=1 or mm=2 then l=l-1
  188. 696 return
  189. 700 for x=yy to ky step1*sgn(ky-yy)
  190. 704 if((x/4=int(x/4))and(x/100<>int(x/100)))or(x/400=int(x/400))then l=l+1
  191. 708 next
  192. 712 if((yy/4=int(yy/4))and(yy/100<>int(yy/100)))or(yy/400=int(yy/400))then680
  193. 716 goto696
  194. 720 printtab(22)"[154]"dw$
  195. 724 poke2040,n1:poke2041,n2:poke2042,n3:poke2043,n4:pokev+21,n5:pokev+39,n6
  196. 728 pokev+40,n7:pokev+41,n8:pokev+42,n9
  197. 732 print"":printtab(16)
  198. 736 on mm goto740,768,796,796,800,840,856,856,860,861,896,924
  199. 740 if mm=1 and dd=0 then print"    new year's [154]day";
  200. 741 if yy>1985 and mm=1 and(dd>13anddd<21)and dw$=" monday"then743
  201. 742 goto746
  202. 743 print"   m. l. king jr.'s":printtab(23)"birthday"
  203. 744 printtab(23)"observed[145][145][145]":goto768
  204. 746 ifyy>1985andmm=1anddd=14thenprint"   [154]m. l. king jr.'s":goto752
  205. 748 goto768
  206. 752 printtab(23)"birthday[145][145]"
  207. 768 if mm=2 and dd=1 then print"    [154]groundhog day";
  208. 772 if yy>1865 and mm=2 and dd=11 then print"  [156]lincoln's birthday";
  209. 776 if mm=2 and dd=13 then print"   valentine's day";
  210. 780 if yy>1970 and mm=2 and (dd>13 and dd<21) and dw$=" monday" then786
  211. 784 goto792
  212. 786 if yy>1990 then print"   presidents' day";:goto 792
  213. 788 print" washington's birthday":printtab(23)"observed[145]";
  214. 792 if yy>1799 and mm=2 and dd=21 then print"washington's birthday";
  215. 796 if mm=3 and dd=16 then print"  [153]st. patrick's day";
  216. 800 if yy>1906 and mm=5 and (dd>6 and dd<14) and dw$=" sunday" then808
  217. 804 goto812
  218. 808 print"    [154]mother's day";
  219. 812 if yy>1949 and mm=5 and(dd>13 and dd<21)and dw$="saturday" then820
  220. 816 goto821
  221. 820 print"   armed forces day";
  222. 821 if yy>1970 and mm=5 and dd>23 and dw$=" monday"then823
  223. 822 goto824
  224. 823 print"    memorial day":printtab(22)"observed[145][145]":goto840
  225. 824 if yy>1867 and mm=5 and dd=29 then print"    memorial day[145]"
  226. 840 if yy>1776 and mm=6 and dd=13 then print"      flag day";
  227. 844 if yy>1909 and mm=6 and(dd>13 and dd<21)and dw$=" sunday"then852
  228. 848 goto856
  229. 852 print"    [154]father's day";
  230. 856 ifyy>1775andmm=7anddd=3thenprint"   in[154]dep[154]end[154]enc[154]e da[154]y";
  231. 860 if yy>1893 and mm=9 and dd<8 and dw$=" monday"then print"      labor day";
  232. 861 if yy>1970 and mm=10 and (dd>6 and dd<14) and dw$=" monday" then863
  233. 862 goto864
  234. 863 print"    columbus day":printtab(22)"observed[145]";:goto880
  235. 864 if mm=10 and dd=11 then print"    [154]columbus day[145]"
  236. 880 if yy>1970 and mm=10 and(dd>20 and dd<28)and dw$=" monday" then888
  237. 884 goto892
  238. 888 print"    veteran's day"chr$(13)"                      observed[145]";
  239. 892 if mm=10 and dd=30 then print"      halloween";
  240. 896 ifyy>1871andmm=11and(dd>0anddd<8)anddw$=" tuesday"then904
  241. 900 goto908
  242. 904 print"    election day";
  243. 908 if yy>1953 and mm=11 and dd=10 then print"    veteran's day";
  244. 912 ifyy>1938andmm=11and(dd>20anddd<28)anddw$="thursday"then923
  245. 921 if(yy>1862andyy<1939)andmm=11anddd>22anddw$="thursday"then923
  246. 922 goto924
  247. 923 print"   [129]thanksgiving day";
  248. 924 if mm=12 and dd=24 then print"    christmas day";
  249. 928 print"[145][145][145][145][145][145][145][145]"
  250. 932 return
  251. 936 pokesd+5,8:pokesd+6,240:pokesd,0:pokesd+1,90:pokesd+4,17:fors=1to100:next
  252. 940 goto948
  253. 944 pokesd+5,8:pokesd+6,240:pokesd,0:pokesd+1,90:pokesd+4,17:fors=1to500:next
  254. 948 poke sd+4,0:poke sd,0:poke sd+1,0:return
  255. 952 end
  256. 956 data000,000,255,000,007,255,000,031
  257. 960 data255,000,127,255,000,255,255,001
  258. 964 data255,255,003,255,255,007,255,255
  259. 968 data015,255,255,031,255,255,031,255
  260. 972 data255,063,255,255,063,255,255,127
  261. 976 data255,255,127,255,255,127,255,255
  262. 980 data255,255,255,255,255,255,255,255
  263. 984 data255,255,255,255,255,255,255
  264. 988 data255,000,000,255,224,000,255,248
  265. 992 data000,255,254,000,255,255,000,255
  266. 996 data255,128,255,255,192,255,255,224
  267. 1000 data255,255,240,255,255,248,255,255
  268. 1004 data248,255,255,252,255,255,252,255
  269. 1008 data255,254,255,255,254,255,255,254
  270. 1012 data255,255,255,255,255,255,255,255
  271. 1016 data255,255,255,255,255,255,255
  272. 1020 data255,255,255,255,255,255,255,255
  273. 1024 data255,255,255,255,255,255,255,127
  274. 1028 data255,255,127,255,255,127,255,255
  275. 1032 data063,255,255,063,255,255,031,255
  276. 1036 data255,031,255,255,015,255,255,007
  277. 1040 data255,255,003,255,255,001,255,255
  278. 1044 data000,255,255,000,127,255,000,031
  279. 1048 data255,000,007,255,000,000,255
  280. 1052 data255,255,255,255,255,255,255,255
  281. 1056 data255,255,255,255,255,255,255,255
  282. 1060 data255,254,255,255,254,255,255,254
  283. 1064 data255,255,252,255,255,252,255,255
  284. 1068 data248,255,255,248,255,255,240,255
  285. 1072 data255,224,255,255,192,255,255,128
  286. 1076 data255,255,000,255,254,000,255,248
  287. 1080 data000,255,224,000,255,000,000
  288. 1084 data000,000,255,000,007,000,000,024
  289. 1088 data000,000,096,000,000,128,000,001
  290. 1092 data000,000,002,000,000,004,000,000
  291. 1096 data008,000,000,016,000,000,016,000
  292. 1100 data000,032,000,000,032,000,000,064
  293. 1104 data000,000,064,000,000,064,000,000
  294. 1108 data128,000,000,128,000,000,128,000
  295. 1112 data000,128,000,000,128,000,000
  296. 1116 data255,000,000,000,224,000,000,024
  297. 1120 data000,000,006,000,000,001,000,000
  298. 1124 data000,128,000,000,064,000,000,032
  299. 1128 data000,000,016,000,000,008,000,000
  300. 1132 data008,000,000,004,000,000,004,000
  301. 1136 data000,002,000,000,002,000,000,002
  302. 1140 data000,000,001,000,000,001,000,000
  303. 1144 data001,000,000,001,000,000,001
  304. 1148 data128,000,000,128,000,000,128,000
  305. 1152 data000,128,000,000,128,000,000,064
  306. 1156 data000,000,064,000,000,064,000,000
  307. 1160 data032,000,000,032,000,000,016,000
  308. 1164 data000,016,000,000,008,000,000,004
  309. 1168 data000,000,002,000,000,001,000,000
  310. 1172 data000,128,000,000,096,000,000,024
  311. 1176 data000,000,007,000,000,000,255
  312. 1180 data000,000,001,000,000,001,000,000
  313. 1184 data001,000,000,001,000,000,001,000
  314. 1188 data000,002,000,000,002,000,000,002
  315. 1192 data000,000,004,000,000,004,000,000
  316. 1196 data008,000,000,008,000,000,016,000
  317. 1200 data000,032,000,000,064,000,000,128
  318. 1204 data000,001,000,000,006,000,000,024
  319. 1208 data000,000,224,000,255,000,000
  320. 1212 data255,000,000,127,224,000,063,248
  321. 1216 data000,015,254,000,007,255,000,003
  322. 1220 data255,128,001,255,192,001,255,224
  323. 1224 data000,255,240,000,127,248,000,127
  324. 1228 data248,000,063,252,000,063,252,000
  325. 1232 data031,254,000,031,254,000,031,254
  326. 1236 data000,031,255,000,015,255,000,015
  327. 1240 data255,000,015,255,000,015,255
  328. 1244 data000,015,255,000,015,255,000,015
  329. 1248 data255,000,015,255,000,031,255,000
  330. 1252 data031,254,000,031,254,000,031,254
  331. 1256 data000,063,252,000,063,252,000,127
  332. 1260 data248,000,127,248,000,255,240,001
  333. 1264 data255,224,001,255,192,003,255,128
  334. 1268 data007,255,000,015,254,000,063,248
  335. 1272 data000,127,224,000,255,000,000
  336. 1276 data000,000,255,000,007,254,000,031
  337. 1280 data252,000,127,240,000,255,224,001
  338. 1284 data255,192,003,255,128,007,255,128
  339. 1288 data015,255,000,031,254,000,031,254
  340. 1292 data000,063,252,000,063,252,000,127
  341. 1296 data248,000,127,248,000,127,248,000
  342. 1300 data255,248,000,255,240,000,255,240
  343. 1304 data000,255,240,000,255,240,000
  344. 1308 data255,240,000,255,240,000,255,240
  345. 1312 data000,255,240,000,255,248,000,127
  346. 1316 data248,000,127,248,000,127,248,000
  347. 1320 data063,252,000,063,252,000,031,254
  348. 1324 data000,031,254,000,015,255,000,007
  349. 1328 data255,128,003,255,128,001,255,192
  350. 1332 data000,255,224,000,127,240,000,031
  351. 1336 data252,000,007,254,000,000,255
  352. 1340 data000,031,255,000,031,255,000,031
  353. 1344 data255,000,031,255,000,015,255,000
  354. 1348 data015,255,000,015,255,000,015,255
  355. 1352 data000,007,255,000,007,255,000,003
  356. 1356 data255,000,003,255,000,001,255,000
  357. 1360 data000,255,000,000,255,000,000,127
  358. 1364 data000,000,063,000,000,031,000,000
  359. 1368 data015,000,000,003,000,000,000
  360. 1372 data000,000,000,000,000,003,000,000
  361. 1376 data015,000,000,031,000,000,063,000
  362. 1380 data000,127,000,000,255,000,000,255
  363. 1384 data000,001,255,000,003,255,000,003
  364. 1388 data255,000,007,255,000,007,255,000
  365. 1392 data015,255,000,015,255,000,015,255
  366. 1396 data000,015,255,000,031,255,000,031
  367. 1400 data255,000,031,255,000,031,255
  368. 1404 data000,000,000,192,000,000,240,000
  369. 1408 data000,248,000,000,252,000,000,254
  370. 1412 data000,000,255,000,000,255,000,000
  371. 1416 data255,128,000,255,192,000,255,192
  372. 1420 data000,255,224,000,255,224,000,255
  373. 1424 data240,000,255,240,000,255,240,000
  374. 1428 data255,240,000,255,248,000,255,248
  375. 1432 data000,255,248,000,255,248,000
  376. 1436 data255,248,000,255,248,000,255,248
  377. 1440 data000,255,248,000,255,240,000,255
  378. 1444 data240,000,255,240,000,255,240,000
  379. 1448 data255,224,000,255,224,000,255,192
  380. 1452 data000,255,192,000,255,128,000,255
  381. 1456 data000,000,255,000,000,254,000,000
  382. 1460 data252,000,000,248,000,000,240,000
  383. 1464 data000,192,000,000,000,000,000
  384.